unit uGUDPSpeedTest;

interface

uses
  SysUtils, Classes, Windows, uDZSysUtils, uDZPersistent, uDZSocket;

const
  gcFlagC2S: Char = #62;
  gcCmd56 = 56;
  gcExtCmdGetMsgSrvInfo = 0;
  gcMaxPorts = 3;
  gcSQPort = 6299;

type
  TRequestDataHead = packed record
    tvFlag: Char;
    tvCommand: Byte;
  end;

  TResponseDataHead = packed record
    tvRequest: TRequestDataHead;
    tvError: Byte;
  end;

  TRequestDataHead56 = packed record
    tvHead: TRequestDataHead;
    tvExtCmd: Byte;
  end;
  
  TResponseDataSrvInfo = packed record
    tvHead: TResponseDataHead;
    tvServerName: string[32];
    tvConnections: Cardinal;
    tvPortCount: Byte;
    tvPorts: array[0..gcMaxPorts-1] of Word;
  end;

  PSocketSvcEntry = ^TSocketSvcEntry;
  TSocketSvcEntry = object
  private
    fPorts: array of Word;
    function GetPorts(Index: Integer): Word;
    procedure SetPorts(Index: Integer; const Value: Word);
    function GetPortCount: Integer;
  public
    IP: AnsiString;
    Name: WideString;
    Delay: Integer;
    ForwardLink: PSocketSvcEntry;
  public
    procedure AddPort(Port: Word);
    procedure DeletePort(Port: Word);
    procedure Delete(Index: Integer);
    property Ports[Index: Integer]: Word read GetPorts write SetPorts;
    property PortCount: Integer read GetPortCount;
  end;

function SpeedTest(const IPS: array of AnsiString): PSocketSvcEntry;

implementation

function SpeedTest(const IPS: array of AnsiString): PSocketSvcEntry;
var
  UDPSocket: TDzUDPSocket;
  request: TRequestDataHead56;
  response: TResponseDataSrvInfo;
  i, j, timeout, len: Integer;
  tick, delay: DWORD;
  InputBuffer: array [0..511] of AnsiChar;
  ip: AnsiString;
  port: Word;
  pEntry: PSocketSvcEntry;
  IPS2: array of AnsiString;
const
  lcMaxWait = 2000;
  lcGoodWait = 500;
begin
  Result := nil;
  SetLength(IPS2, Length(IPS));
  for i := 0 to Length(IPS) - 1 do IPS2[i] := IPS[i];
  UDPSocket := TDzUDPSocket.Create;
  try
    try
      UDPSocket.Open;
    except

    end;
    request.tvHead.tvFlag := gcFlagC2S;
    request.tvHead.tvCommand := gcCmd56;
    request.tvExtCmd := gcExtCmdGetMsgSrvInfo;
    for i := 0 to Length(IPS) - 1 do
      UDPSocket.SendTo(IPS[i], gcSQPort, request, SizeOf(request));
    timeout := lcMaxWait;
    tick := Windows.GetTickCount;
    while (timeout > 0) and (Length(IPS2) > 0) do
    begin
      try
        if UDPSocket.Readable(timeout) then
        begin
          delay := LongWordDiff(tick, GetTickCount);
          Dec(timeout, delay);
          try
            len := UDPSocket.Read(ip, port, InputBuffer, SizeOf(InputBuffer));
            for i := Low(IPS2) to High(IPS2) do
            begin
              if IPS2[i] = ip then
              begin
                if port = gcSQPort then 
                begin
                  for j := i + 1 to High(IPS2) do IPS2[j - 1] := IPS2[j];
                  SetLength(IPS2, Length(IPS2) - 1);
                  Move(InputBuffer, response, SizeOf(response));
                  if len >= SizeOf(response) then
                  begin
                    New(pEntry);
                    pEntry^.Delay := delay;
                    pEntry^.IP := ip;
                    pEntry^.Name := response.tvServerName;
                    pEntry.ForwardLink :=  nil;
                    for j := 0 to response.tvPortCount - 1 do
                      pEntry^.AddPort(response.tvPorts[j]);
                    if Assigned(Result) then Result^.ForwardLink := pEntry
                    else Result := pEntry;
                  end;
                end;
                Break;
              end;
            end;
          except

          end;
        end
        else Break;
      except
        Break;
      end;
    end;
  finally
    UDPSocket.Free;
  end;
end;

{ TSocketSvcEntry }

procedure TSocketSvcEntry.AddPort(Port: Word);
begin
  SetLength(fPorts, Length(fPorts) + 1);
  fPorts[High(fPorts)] := Port;  
end;

procedure TSocketSvcEntry.Delete(Index: Integer);
var
  i: Integer;
begin
  if (Index >= Low(fPorts)) and (Index <= High(fPorts)) then
  begin
    for i := Index + 1 to High(fPorts) do
      fPorts[i - 1] := fPorts[i];
    SetLength(fPorts, Length(fPorts) - 1);
  end;
end;

procedure TSocketSvcEntry.DeletePort(Port: Word);
var
  index: Integer;
begin
  for index := Low(fPorts) to High(fPorts) do
    if fPorts[index] = Port then 
    begin
      Delete(index);
      Break;
    end;  
end;

function TSocketSvcEntry.GetPortCount: Integer;
begin
  Result := Length(fPorts);
end;

function TSocketSvcEntry.GetPorts(Index: Integer): Word;
begin
  if (Index >= Low(fPorts)) and (Index <= High(fPorts)) then
    Result := fPorts[Index]
  else Result := 0;
end;

procedure TSocketSvcEntry.SetPorts(Index: Integer; const Value: Word);
begin
  if (Index >= Low(fPorts)) and (Index <= High(fPorts)) then
    fPorts[Index] := Value;
end;

end.
